perm filename ENTROG.SAI[PIX,HPM] blob sn#442981 filedate 1979-05-20 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "ENTRO5"
C00007 ENDMK
C⊗;
BEGIN "ENTRO5"
REQUIRE "PIXHDR.SAI[VIS,HPM]" SOURCE_FILE;
DEFINE NLIST=112000; INTEGER LAVAIL;
SAFE INTEGER ARRAY LIST[0:NLIST];  SAFE REAL ARRAY PRED[0:NLIST];

INTEGER I,J,K,L,C,D,DD,E,F,PICLNBY; REAL INF,INP,PA,PB,LINF,LINP;
STRING BF; INTEGER SAFE ARRAY PIC[0:10];
DEFINE L2LEN=5000;
REAL SAFE ARRAY L2[0:L2LEN];
INTEGER CONTEX,CONTEX2;

IF FALSE THEN
 BEGIN STRING A; EQU(A,A); CALL(0,0); A←CVXSTR(0); A←CVSIX("0"); A←A[1 TO 1]; END;

FOR I←0 STEP 1 UNTIL L2LEN DO L2[I]←-LOG((I/L2LEN) MAX 0.00001)/LOG(2);
DO PRINT("BIT FILE:") UNTIL PFLDIM(BF←INCHWL)>0;
WHILE TRUE DO
   BEGIN
   INTEGER CH; STRING S;
   PRINT("Window size (must be odd):"); CONTEX←CVD(INCHWL); CONTEX2←CONTEX*CONTEX;
   PRINT("Gain rate (ε):"); PA←REALSCAN(S←INCHWL,I); PB←1-PA;
   CH←OPNPFL(BF,PIC[0]);
   PICLNBY←PIC[LNBY];

      BEGIN
      INTEGER ARRAY HASH[0:(1 ASH ((CONTEX2-1)%2))-1];
      INTEGER SAFE ARRAY BPS[0:CONTEX-1,0:CONTEX-1],BPT[0:CONTEX2-1];
      INTEGER SAFE ARRAY BITS[0:CONTEX-1,-1:PIC[LNWD]-1];
      ARRCLR(HASH,0); LAVAIL←NLIST;
        
      FOR I←0 STEP 1 UNTIL CONTEX-1 DO
      FOR J←0 STEP 1 UNTIL CONTEX-1 DO
	 BPS[I,J]←POINT(1,BITS[I,-1],36-CONTEX+J);

      INF←0; INP←0; LINF←LINP←0;
      FOR L←0 STEP 1 UNTIL PIC[PCLN]-1 DO
	 BEGIN
	 ARRYIN(CH,BITS[L MOD CONTEX,0],PIC[LNWD]);

	 FOR I←0 STEP 1 UNTIL CONTEX-2 DO
	 FOR J←0 STEP 1 UNTIL CONTEX-1 DO  BPS[I,J]↔BPS[I+1,J];

	 ARRBLT(BPT[0],BPS[0,0],CONTEX2);
	 FOR J←0 STEP 1 UNTIL PICLNBY-1 DO
	    BEGIN
	    D←ILDB(BPT[0]); DD←ILDB(BPT[1]);
	    FOR K←2 STEP 2 UNTIL CONTEX2-3 DO
               BEGIN
               D←(D LSH 1) LOR ILDB(BPT[K]);
               DD←(DD LSH 1) LOR ILDB(BPT[K+1]);
               END;
	    F←E←HASH[D];
            WHILE E>0 ∧ (LIST[E] LSH -18)≠DD DO
	       BEGIN
	       F←E;
	       E←LIST[E] LAND '777777;
	       END;
	    IF E>0 THEN C←E ELSE
	       BEGIN
	       LAVAIL←LAVAIL-1; IF LAVAIL≤0 THEN
                  BEGIN PRINT("out of storage!!!"); CALL(0,"EXIT"); END;
               LIST[LAVAIL]←(DD LSH 18);
	       PRED[LAVAIL]←0.5;
               IF F=0 THEN HASH[D]←LAVAIL ELSE LIST[F]←LIST[F] LOR LAVAIL;
	       C←LAVAIL;
	       END;
	    IF ILDB(BPT[CONTEX2-1]) THEN
	       BEGIN
	       INF←INF + L2[L2LEN*PRED[C]];
	       PRED[C]←(PRED[C]*PB+PA) MIN .99999;
	       END
	    ELSE
	       BEGIN
	       INF←INF + L2[L2LEN*(1-PRED[C])];
	       PRED[C]←(PRED[C]*PB) MAX .00001;
	       END;
	    END;
	 INP←INP+PICLNBY;
	 IF (L MOD 100)=0 THEN
            BEGIN
            PRINT(INP,"/",INF," = ",INP/INF," local ",(INP-LINP)/(INF-LINF),'15&'12);
            LINF←INF; LINP←INP;
            END;
     	 END;
      PRINT(INP,"/",INF," = ",INP/INF," local ",(INP-LINP)/(INF-LINF),'15&'12);
      E←0; D←HASH[0]; WHILE D>0 DO BEGIN E←E+1; D←LIST[D] LAND '777777; END;
      PRINT("HASH[0] length ",E,'15&'12);
      END;
   RELEASE(CH);
   END;

END "ENTRO5";